home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / gfx / show / PlayKiSS0_88.lha / PlayKiss / src / celtoppm.e next >
Text File  |  1994-10-31  |  4KB  |  160 lines
  1.  
  2. MODULE 'dos/dos'
  3.  
  4. DEF rdarg
  5. DEF argarray[11]:LIST
  6. DEF source[250]:STRING
  7. DEF dest[250]:STRING
  8. DEF palette[250]:STRING
  9. DEF dummy[250]:STRING
  10. DEF fh1,fh2,fh3,res,i,t,offset
  11. DEF re[18]:LIST,gr[18]:LIST,bl[18]:LIST
  12. DEF red,grn,blu
  13. DEF buffer,buffer2
  14. DEF x,y,w,h,nw
  15. DEF long
  16. DEF r1,g1,b1,r2,g2,b2
  17. DEF res1,res2
  18.  
  19. RAISE "^C" IF CtrlC ()=TRUE
  20.  
  21. PROC ibmconv(a)
  22.     DEF hi,lo,ret
  23.     hi:=a AND $FF00
  24.     lo:=a AND $00FF
  25.     ret:=Shl(lo,8) OR Shr(hi,8)
  26. ENDPROC ret
  27.  
  28. PROC readstring(fh,buf)
  29.     DEF ret=0,bp=0
  30.  
  31.     PutLong(buf,0)
  32.     PutLong(buf+4,0)
  33.     Read(fh,buf+bp,1);bp:=bp+1
  34.     WHILE (iswhitespace(Char(buf+bp-1))=0)
  35.         Read(fh,buf+bp,1);bp:=bp+1
  36.         CtrlC()
  37.     ENDWHILE
  38.     PutChar(buf+bp-1,0)
  39.     StrToLong(buf,{ret})
  40. ENDPROC ret
  41.  
  42. PROC iswhitespace(a)
  43.     IF a=10 THEN RETURN TRUE
  44.     IF a=9 THEN RETURN TRUE
  45.     IF a=13 THEN RETURN TRUE
  46.     IF a=32 THEN RETURN TRUE
  47.     IF a="," THEN RETURN TRUE
  48. ENDPROC FALSE
  49.  
  50. PROC main() HANDLE
  51.     buffer:=New(10000)
  52.     buffer2:=New(700*6)
  53.     argarray[0]:=0
  54.     argarray[1]:=0
  55.     argarray[2]:=0
  56.     rdarg:=ReadArgs('FROM/A,TO,KCF/A',argarray,0)
  57.  
  58.     IF argarray[0]>NIL
  59.         StrCopy(source,argarray[0],ALL)
  60.     WriteF('\h  ',argarray[0])
  61.     ELSE
  62.         Raise("HELP")
  63.     ENDIF
  64.     IF argarray[1]>NIL
  65.         StrCopy(dest,argarray[1],ALL)
  66.         IF StrLen(dest)<1
  67.             StrCopy(dest,source,ALL)
  68.             i:=InStr(UpperStr(dest),'.CEL')
  69.             StrCopy(dest,source,i)
  70.             StrAdd(dest,'.ppm',ALL)
  71.         ENDIF
  72.     ELSE
  73.         StrCopy(dest,source,ALL)
  74.         i:=InStr(UpperStr(dest),'.CEL')
  75.         StrCopy(dest,source,i)
  76.         StrAdd(dest,'.ppm',ALL)
  77.     ENDIF
  78.     IF argarray[2]>NIL
  79.         StrCopy(palette,argarray[2],ALL)
  80.     ELSE
  81.         Raise("HELP")
  82.     ENDIF
  83.  
  84. WriteF('Translating "\s" to "\s"...\n',source,dest)
  85.     CtrlC()
  86.     IF rdarg>0
  87.         IF (fh3:=Open(palette,MODE_OLDFILE))
  88.             Read(fh3,buffer,32)
  89.             IF StrCmp(buffer,'KiSS',4) THEN Read(fh3,buffer,32)
  90.             t:=0
  91.             FOR i:=0 TO 31 STEP 2
  92.         red:=(Char(buffer+i) AND $F0)
  93.         blu:=Shl((Char(buffer+i) AND $0F),4)
  94.         grn:=Shl((Char(buffer+i+1) AND $0F),4)
  95.         re[i/2]:=red;gr[i/2]:=grn;bl[i/2]:=blu
  96.       ENDFOR
  97.             CtrlC()
  98.             IF (fh1:=Open(source,MODE_OLDFILE))
  99.                 IF (fh2:=Open(dest,MODE_NEWFILE))
  100.                     Read(fh1,buffer,4)
  101.                     IF StrCmp(buffer,'KiSS',4)
  102.                         Read(fh1,buffer,28)
  103.                         w:=ibmconv(Int(buffer+4))
  104.                         h:=ibmconv(Int(buffer+6))
  105.                     ELSE
  106.                         w:=ibmconv(Int(buffer))
  107.                         h:=ibmconv(Int(buffer+2))
  108.                     ENDIF
  109.  
  110. WriteF('Source image size= \d x \d \n',w,h)
  111.  
  112.                     StringF(dummy,'P6\n\d \d \d\n',w,h,255)
  113.                     Write(fh2,dummy,StrLen(dummy))
  114.  
  115.                     FOR y:=0 TO h-1
  116.                         res:=Read(fh1,buffer,w/2)
  117.                         IF (res<0) THEN Raise("DOS")
  118.                         CtrlC()
  119.                         FOR x:=0 TO ((w-1)/2)
  120.  
  121.                             r1:=Shr((Char(buffer+x) AND $F0),4)
  122.                             r2:=Char(buffer+x) AND $0F
  123.  
  124.                             PutChar(buffer2+(x*6),re[r1])
  125.                             PutChar(buffer2+(x*6)+1,gr[r1])
  126.                             PutChar(buffer2+(x*6)+2,bl[r1])
  127.                             PutChar(buffer2+(x*6)+3,re[r2])
  128.                             PutChar(buffer2+(x*6)+4,gr[r2])
  129.                             PutChar(buffer2+(x*6)+5,bl[r2])
  130.  
  131.                         ENDFOR
  132.                         Write(fh2,buffer2,w*3)
  133.                     ENDFOR
  134.                 ELSE
  135.                     Raise("DOS")
  136.                 ENDIF
  137.             ELSE
  138.                 Raise("DOS")
  139.             ENDIF
  140.         ELSE
  141.             Raise("DOS")
  142.         ENDIF
  143.     ELSE
  144.         Raise("NONE")
  145.     ENDIF
  146. EXCEPT DO
  147.     IF rdarg THEN FreeArgs(rdarg)
  148.     IF fh1 THEN Close(fh1)
  149.     IF fh2 THEN Close(fh2)
  150.     IF fh3 THEN Close(fh3)
  151.     IF buffer THEN Dispose(buffer)
  152.     IF buffer2 THEN Dispose(buffer2)
  153.     IF exception="DOS" THEN WriteF('An error occured.\n\n')
  154.     IF exception="HELP" THEN WriteF('Usage: celtoppm FROM\\A,TO,KCF\\A\n\n')
  155.     IF exception="PAL" THEN WriteF('Colors do not match.  Use "ppmquant -map".\n\n')
  156.     IF exception="P6P6" THEN WriteF('Map file contains more than 16 colors.\n\n')
  157.     IF exception="NOP6" THEN WriteF('Map file is invalid.\n\n')
  158.     IF exception="NOP5" THEN WriteF('Source file is invalid.\n\n')
  159. ENDPROC
  160.